00100	C THIS AIDS IN EXTRACTING PARTS FROM SCORES - OR PACKING OF .DAT
00200	C   FILES FOR EASIER STORAGE.   
00300	      DIMENSION XN(2000),RSTFAC(8),IV(78),LIST(200),PWDS(250),RN(2000)
00400		1,XWDS(250),STFF(8)
00500	C**** RN MIGHT HAVE TO BE 4000 ******
00600	CC	EQUIVALENCE (XN,IV),(XWDS,LIST)
00700	
00800	14	JT=0
00900		JR=0
01800		REWIND 1
02100		TYPE 1
02200		ACCEPT 2,NAME
02300		IF(LOOKD(NAME).GE.0)GO TO 13
02400		TYPE 88
02500		ACCEPT 2,L
02600		IF(L.EQ.'N')GO TO 14
02700	88	FORMAT(' WRITE OVER FILE????  '$)
02800	13	CALL OFILE(1,NAME)
02900		XWDS(1)=1
03000		RM=0
03100		L=1
03200		LX=1
03300		LP=1
03400		TYPE 44
03500		ACCEPT 5,RS
03600	10	IF(JT.EQ.0)GO TO 83
03700		NAME=NAME+2
03800		GO TO 84
03900	86	FORMAT(1XA5)
04000	83	TYPE 3
04100		ACCEPT 2,NAME,JT,NBAR
04200	C  TYPE ANY NUMBER AFTER NAME AND IT WILL GO TO NEXT LETTER IN ALPH.
04250		IF(NBAR.NE.0)NBAR=-1
04275	C  ANY THIRD NUM. SUPPRESSES SCORE BARLINE FEATURE
04300	84	LK=LP
04400		IF(LOOKD(NAME).GE.0)GO TO 20
04500	C  FOUND NO MORE TO READ
04600		TYPE 86,NAME
04700		JZ=0
04800		IF(RM.NE.0)GO TO 77
04900		TYPE 4
05000		ACCEPT 5,SN,TR,RM
05100		IF(SN.GE.99)GO TO 20
05150		K=SN/100.
05200		GO TO 77
05300	C TYPE 2ND NUM FOR TRANSPOSE, 3RD NUM FOR ALWAYS SAME STFF.
05400	8	DO 6 K=1,ITEM
05500		J=PWDS(K)
05600		IF(RN(J+1).NE.4.OR.NBAR)GO TO 80
05700		IF(RN(J).NE.2)GO TO 80
05800	C  FOUND A BAR LINE
05810		KB=RN(J+4)/100.
05900		RN(J+4)=1.+KB*100.
05910	C  KB IS FOR THICK BARS.
06000		R=RN(J+2)
06100		DO 82 KA=K+1,ITEM
06200		KB=PWDS(KA)
06300		IF(RN(KB+1).NE.4.OR.RN(KB).NE.2)GO TO 82
06400	C  AVOIDS DUPLICATE BARS.
06500		IF(ABS(R-RN(KB+2)).GT..5)GO TO 82
06600		RN(KB+3)=99
06700		RN(KB+1)=0
06800	82	CONTINUE
06900		GO TO 81
07000	80	IF(RN(J+3).NE.SN)GO TO 6
07100		IF(RN(J+1).NE.10)GO TO 85
07200		IF(RN(J).LT.3)GO TO 85
07300		RN(J+5)=0
07400	C  SETS VERT. POS. OF STAFF TO 0.  WHAT ABOUT P6??!
07500	85	JZ=-1
07600	81	JA=PWDS(K+1)
07700		DO 7 KA=J,JA-1
07800		XN(LK)=RN(KA)
07900	7	LK=LK+1
08000		IF(L.LT.250.AND.LK.LE.2000)GO TO 50
08100		TYPE 9
08200		GO TO 20
08300	16	FORMAT(' STAFF NOT FOUND'/)
08400	50	R=XN(LP+1)
08500		IF(TR.NE.0.AND.(R.EQ.1.OR.R.EQ.8.OR.R.EQ.9))GO TO 52
08600	51	XN(LP+3)=RS
08700		L=L+1
08800		LP=LK
08900		XWDS(L)=LP
09000	6	CONTINUE
09100		IF(JZ)GO TO 17
09200		L=JX
09300		LP=JY
09400		TYPE 16
09500		GO TO 10
09600	17	JX=L
09700		JY=LP
09800		RS=RS-1
09810	C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
09900		M=LX+1
10000		J=XWDS(LX)
10100		PWDS(LX)=XWDS(LX)
10200		I=LX
10400	24	RA=10000.
10500	C  POSITION
10700		DO 21 K=LX,L-1
10750		JL=XWDS(K)+2
10800		R=XN(JL)
10810		IF(R.EQ.10000)GO TO 21
10820		IF(ABS(R-RA).GT..1)GO TO 240
10830		R=RA
10840		XN(JL)=R
10850	C  PUT IN HERE MULTI-VOICE TRAP
10860		GO TO 21
10900	240	IF(R.GT.RA)GO TO 21
10975	C  LINES THEM UP
11000		I=K
11100		RA=R
11200	21	CONTINUE
11300		IF(RA.EQ.10000)GO TO 23
11400	C  JUMP IF ALL SORTED
11500		JL=XWDS(I)
11600		LA=JL
11700		N=XN(JL)+3
11800	C  NEXT POINTER
11900		PWDS(M)=PWDS(M-1)+N
12000		M=M+1
12100		DO 22 K=J,J+N-1
12200		RN(K)=XN(JL)
12300	22	JL=JL+1
12400		XN(LA+2)=10000
12500	C  PUT IT ASIDE
12600		J=N+J
12700		GO TO 24
12750	
12800	23	LB=LX
12900	25	N=PWDS(LB)
13000		R=RN(N+1)
13100		IF(R.GT.2.OR.(R.EQ.1.AND.RN(N).LT.7))GO TO 30
13200	C  LOOK ONLY AT NOTES AND RESTS AND NON-DOUBLE STOPS
13250		S=RN(N+2)
13300		LA=LB
13400	26	LA=LA+1
13450		IF(LA.GE.L)GO TO 30
13500	C  FIND NEXT IMPORTANT ITEM
13600		NA=PWDS(LA)
13700		A=RN(NA+1)
13800		IF(A.GT.4.OR.(A.EQ.4.AND.RN(NA).NE.2))GO TO 26
13900	C  USES ONLY NOTES, RESTS, BARS, CLEFS
14000	34	RX=RN(NA+2)
14100	C  POSITION OF NEXT ITEM
14150		IF(S.EQ.RX)GO TO 26
14160		A=RX-2
14170		IF(A.LT.S)A=S+.5
14180	C  SPACING WILL BEGIN NEARBY
14200		K=9
14300		IF(R.EQ.2)K=7
14400		P=RN(N+K)*10.
14500	C  FINDS RHYTH IN P9 OR P7(REST)
14550	C  IF DIFFERENT SIMULTANEOUS RHYTHMS, ZERO OUT LARGER BEFORE HAND.
14600		IF(P)GO TO 30
14610	C  SKIPS NOTES WITH SUPPRESSED LEDGER LINES.
14800		SX=S+P-RX
14900	C  SPACE DIFFERENCE
15000	35	DO 29 K=LX,L-1
15100		NZ=PWDS(K)+2
15110		RA=RN(NZ)
15200		IF(RA.GT.A)RN(NZ)=RA+SX
15201	C  A=BASIC POS. AT THIS TIME.
15202		R=RN(NZ-1)
15205		IF(R489(R))GO TO 29
15207		NZ=NZ-2
15210		IF(RN(NZ).EQ.2)GO TO 29
15212		RB=RN(NZ+6)
15215		IF(RB.GT.A)RN(NZ+6)=RB+SX
15220		IF(RN(NZ).LT.7)GO TO 29
15225	C  FOR IRREGULAR BEAMS
15227		RB=RN(NZ+9)
15230		IF(RB.GT.A)RN(NZ+9)=RB+SX
15232		RB=RN(NZ+8)
15235		IF(RB.GT.A.AND.RN(NZ).GT.8.AND.RN(NZ+10).GE.30)RN(NZ+8)=RB+SX
15240	29	CONTINUE
15300	30	LB=LB+1
15400		IF(LB.LT.L)GO TO 25
15500	C  GO BACK IF MORE SPACING TO DO
15600		SX=200./RN(IFIX(PWDS(L-1)+2))
15700	C `SHRINK' FACTOR
15800		DO 31 K=LX,L-1
15900		N=PWDS(K)+2
15901		RN(N)=RN(N)*SX
15902		R=RN(N-1)
15905		IF(R489(R))GO TO 31
15907		N=N-2
15910		IF(RN(N).EQ.2)GO TO 31
15915		RB=RN(N+6)
15920		RN(N+6)=RB*SX
15925		IF(RN(N).LT.7)GO TO 31
15930	C  FOR IRREGULAR BEAMS
15935		RB=RN(N+9)
15940		RN(N+9)=RB*SX
15945		RB=RN(N+8)
15950		IF(RN(N).GT.8.AND.RN(N+10).GE.30)RN(N+8)=RB*SX
16050	31	CONTINUE
16100		DO 32 K=IFIX(PWDS(LX)),IFIX(PWDS(L))
16200	32	XN(K)=RN(K)
16300		DO 33 K=LX,L
16400	33	XWDS(K)=PWDS(K)
16500	C  ALL DONE
16550	C****↑↑↑↑↑↑  RHYTH. RESET ↑↑↑↑↑↑↑↑↑↑↑
16600		LX=L
16700	
16800		IF(RS.GT.-4)GO TO 10
16900	20	L=JX-1
17000		J=1
17100		WRITE(1),L,JY,
17200		1 (XWDS(K),K=1,L+1),(XN(K),K=1,JY-1),J,J,J,J,RSTFAC,STFF,J
17300	15	END FILE 1
17400		CALL EXIT
17500	1	FORMAT(' TYPE OUTPUT FILE NAME  ',$)
17600	2	FORMAT(A5,2I)
17700	3	FORMAT(' TYPE INPUT NAME, (CONT), (NOBAR)  ',$)
17800	4	FORMAT(' READ WHICH STAFF # ? (TRANS), (SMSTFF) ',$)
17900	5	FORMAT(5F)
18000	9	FORMAT(' NO ROOM FOR THIS ONE')
18100	44	FORMAT(' TYPE TOP OUTPUT STAFF #  ',$)
18200	
19400	77	REWIND 21
19500	177	CALL IFILE(21,NAME)
19700		READ(21),ITEM,I,
19800		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
19900		1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
20000		GO TO 8
30400	
30500	52	A=XN(LP+4)
30600		XN(LP+4)=A+TR
30700	C TRANSPOSES ONLY BY STAFF STEPS FOR NOW
30800		X=XN(LP+5)
30900		IF(XN(LP+1).EQ.1)GO TO 11
31000		XN(LP+5)=X+TR
31100		GO TO 51
31200	11	IF(TR.EQ.4.AND.AMOD(A,7.0).EQ.0)GO TO 101
31300		IF(AMOD(TR-1.0,7.0).NE.0)GO TO 51
31400	C  NEXT IS FOR Bb TRANSP.
31500		B=AMOD(A+7.0,7.0)
31600		IF(B.NE.0.AND.B.NE.3)GO TO 51
31700	C  FINDS ORIG. E OR B
31800	101	M=AMOD(X,10.0)
31900	C  FINDS ACCID.
32000		X=X-M
32100	C  STEM DIR. AND DECI.
32200		B=3.
32300	C CHANGES FLAT TO NATURAL SIGN.
32400		IF(M.EQ.0.OR.M.EQ.3)B=2
32500	C  NO PROVISION YET FOR ## OR bb
32600		XN(LP+5)=X+B
32700		GO TO 51
32800		END
32900	
33000		FUNCTION R489(R)
33100		R489=0
33200		IF(R.NE.9.AND.R.NE.8.AND.R.NE.4.AND.R.NE.20)R489=-1
33300		END